perm filename SOLIT.RLS[206,JMC] blob
sn#057942 filedate 1973-08-13 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 ARRAY SP(4),FP(4)INTEGER N
C00010 ENDMK
C⊗;
ARRAY SP(4),FP(4);INTEGER N;
SYMBOLIC PROCEDURE MERGE(U1,V1);
BEGIN SCALAR U,VV,W,X;
U ← U1; VV ← V1; W ← NIL;
A1: IF NULL U THEN GO TO E1;
A: IF NULL VV THEN GO TO E2;
IF CAR U < CAR VV THEN GO TO C1;
W ← CAR VV . W;
VV ← CDR VV;
GO TO A;
C1: W ← CAR U . W;
U ← CDR U;
GO TO A1;
E1: X ← VV; GO TO E3;
E2: X ← U;
E3: IF NULL W THEN RETURN X;
X ← CAR W . X; W ← CDR W; GO TO E3;
END;
SYMBOLIC PROCEDURE SORT U1;
BEGIN SCALAR U,V,X; INTEGER M;
U ← U1; V ← NIL;
E3: IF NULL U THEN GO TO E4;
M ← 0; X ← LIST CAR U; U ← CDR U;
SORTC: IF NULL V THEN GO TO E1;
IF NULL CAR V THEN GO TO E2;
X ← MERGE(X, CAR V); M ← M+1; V ← CDR V; GO TO SORTC;
E2: V ← X . CDR V;
B1: IF M=0 THEN GO TO E3;
V ← NIL . V; M ← SUB1 M; GO TO B1;
E1: V ← LIST X; GO TO B1;
E4: X ← NIL;
B2: IF NULL V THEN RETURN X;
X ← MERGE(X,CAR V); V ← CDR V; GO TO B2;
END;
SYMBOLIC PROCEDURE START(X);
BEGIN
FOR I←1 STEP 1 UNTIL 4 DO BEGIN SP(I)←NIL;FP(I)←'(0) END;
H0 ← X;
HAND←X;
LEFT ← SORT HAND;
MOVES←NIL;N←1;
RETURN PRINTPOS();
END;
CYCLE X ← (LAMBDA(U);CYCLE1(U,U)) COPY X;
COPY X ← IF NULL X THEN NIL ELSE CAR X . COPY CDR X;
CYCLE1(X,Y) ← IF NULL CDR Y THEN RPLACD(Y,X) ELSE CYCLE1(X,CDR Y);
SYMBOLIC PROCEDURE SHUFFLE X;
BEGIN
Y←CYCLE X;
N←LENGTH X;
M←RANDOM N;
W←NIL;
LOOP: IF M≠0 THEN GO TO AAA;
Z← CADR Y . W;
IF N=1 THEN RETURN Z;
W←Z;
Y←RPLACD(Y,CDDR Y);
N←N-1;
M←RANDOM N;
GO TO LOOP;
AAA: Y ← CDR Y;M←M-1;GO TO LOOP;
END;
SYMBOLIC PROCEDURE PRINTPOS();
BEGIN
WRITE LIST('FINAL,CARR FP 1,CARR FP 2,CARR FP 3,CARR FP 4);
WRITE LIST('STORE,SP 1,SP 2,SP 3,SP 4);
WRITE LIST('HAND,CAR HAND);
WRITE LIST(LENGTH HAND,"LEFT, NAMELY",LEFT);
WRITE " ";
RETURN " ";
END;
CARR(X) ← IF NULL X THEN NIL ELSE CAR(X);
SYMBOLIC PROCEDURE SF(J,I);
BEGIN
IF LENGTH FP(I) < 14 ∧ REMAINDER(CAR FP(I) + I - CAR SP(J),13) = 0 THEN
BEGIN
FP(I)← CAR SP(J) . FP(I); SP(J) ← CDR SP(J); MOVES ← LIST(J,I).MOVES;
N←N+1;
END
ELSE WRITE "ILLEGAL MOVE";
RETURN PRINTPOS();
END;
SYMBOLIC PROCEDURE HS(I);
BEGIN
LEFT ← REMOVE(CAR HAND,LEFT);
SP(I) ← CAR HAND . SP(I); HAND ← CDR HAND; MOVES ← LIST('HS , I).MOVES;
N ← N+1;
RETURN PRINTPOS();
END;
SYMBOLIC PROCEDURE HF(I);
BEGIN
IF LENGTH FP(I) < 14 ∧ REMAINDER(CAR FP I + I - CAR HAND,13) = 0 THEN
BEGIN
LEFT ← REMOVE(CAR HAND,LEFT);
FP(I) ← CAR HAND . FP(I); HAND ← CDR HAND; MOVES ← LIST('HF , I).MOVES;
N ← N+1;
END
ELSE WRITE "ILLEGAL";
RETURN PRINTPOS();
END;
SYMBOLIC PROCEDURE BACK(I);
BEGIN
FOR J ← 1:I DO
BEGIN
IF NOT NULL MOVES THEN
BEGIN
IF CAAR MOVES EQ 'HS THEN
BEGIN HAND ← CAR SP CADAR MOVES . HAND; SP CADAR MOVES ← CDR SP CADAR MOVES END
ELSE IF CAAR MOVES EQ 'HF THEN
BEGIN HAND ← CAR FP CADAR MOVES . HAND; FP CADAR MOVES ← CDR FP CADAR MOVES END
ELSE
BEGIN SP CAAR MOVES ← CAR FP CADAR MOVES . SP CAAR MOVES;
FP CADAR MOVES ← CDR FP CADAR MOVES END;
MOVES ← CDR MOVES;
N ← N-1;
END;
END;
LEFT ← SORT HAND;
RETURN PRINTPOS()
END;
LEGAL(X,J) ← X ≠ 0 ∧ REMAINDER(CAR FP(J) + J -X,13)=0;
SYMBOLIC PROCEDURE FMOVES();
BEGIN SCALAR MOVES;
MOVES ← NIL;
FOR I ← 1:4 DO FOR J ← 1:4 DO
IF NOT NULL SP I ∧ LEGAL(CAR SP I,J) THEN MOVES ← LIST('SF,I,J) . MOVES;
IF NOT NULL HAND THEN
FOR J←1:4 DO IF LEGAL(CAR HAND,J) THEN MOVES ← LIST('HF,J) . MOVES;
IF NOT NULL HAND THEN FOR I ← 1:4 DO MOVES ← LIST('HS,I) . MOVES;
RETURN MOVES;
END;
MAKE MOVE ← IF CAR MOVE EQ 'HS THEN HS(CADR MOVE)
ELSE IF CAR MOVE EQ 'HF THEN HF(CADR MOVE)
ELSE IF CAR MOVE EQ 'SF THEN SF(CADR MOVE,CADDR MOVE)
ELSE ERROR("NOT A MOVE - MAKE");
POTZ() ← (LAMBDA(M); IF NULL M THEN
(LAMBDA (X);'DONE)
(IF NULL HAND ∧ NULL SP 1 ∧ NULL SP 2 ∧ NULL SP 3 ∧ NULL SP 4
THEN PRINT "YOU WIN" ELSE PRINT "YOU LOSE")
ELSE MAKE CAR SHUFFLE M) FMOVES();
POTZ2() ← (LAMBDA(M); IF NULL M THEN
(LAMBDA (X);'DONE)
(IF NULL HAND ∧ NULL SP 1 ∧ NULL SP 2 ∧ NULL SP 3 ∧ NULL SP 4
THEN PRINT "YOU WIN" ELSE PRINT "YOU LOSE")
ELSE MAKE CAR REVERSE M) FMOVES();
SYMBOLIC PROCEDURE PLAY STRAT;
BEGIN SCALAR R;
L: R ← IF STRAT = 'POTZ THEN POTZ()
ELSE IF STRAT = 'POTZ2 THEN POTZ2()
ELSE RETURN "NOT A STRATEGY";
IF R = 'DONE THEN RETURN 'DONE ELSE GO TO L;
END;
REMOVE(X,U) ← IF NULL U THEN ERROR("REMOVE LOSES")
ELSE IF X = CAR U THEN CDR U
ELSE CAR U . REMOVE(X,CDR U);
H1 ← '(10 6 4 1 7 5 5 4 12 12 9 1 7 8 4 13 6 11 9 2 8 7 4 11 13 13 12 5 11
3 2 7 8 12 2 10 10 3 13 1 10 3 8 6 1 3 9 9 11 5 2 6);
H2 ← '(4 8 7 9 3 2 7 10 8 1 11 3 5 5 7 8 2 2 3 12 13 10 11 9 6 1 13 11 6 11
8 9 9 5 4 6 10 12 1 4 12 6 1 2 10 3 13 7 5 12 13 4);
END;